home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Libris Britannia 4
/
science library(b).zip
/
science library(b)
/
ELECTRON
/
1009.ZIP
/
HAM2.ARC
/
UNIGRID.BAS
< prev
next >
Wrap
BASIC Source File
|
1986-04-17
|
12KB
|
253 lines
10 REM WORLDWIDE QTH LOCATOR, CONTEST SCORING AND MAP PROGRAM BY N6NB.
20 REM *A PUBLIC DOMAIN PROGRAM FOR USE ON APPLE, COMMODORE, IBM, TRS-80
30 REM AND OTHER MICROCOMPUTERS WITH BASIC AND AT LEAST 32K OF RAM.
40 REM *THIS PROGRAM CONVERTS LAT-LONG TO 4 AND 6-DIGIT LOCATORS, CALCULATES
50 REM BEAM HEADINGS AND DISTANCE BETWEEN LOCATORS, TALLIES LOCATOR-BASED
60 REM CONTEST SCORES, AND PROVIDES MAP-TO-LOCATOR TRANSLATIONS.
70 REM *THANKS TO WA1JXN, W4RUU, KC6A AND SM5AGM FOR THEIR SUGGESTIONS.
80 REM *NOTE: ENTER MINUS SIGN ('-') FOR EAST LONGITUDE OR SOUTH LATITUDE.
90 REM --IF 0 DEGREES EAST OR SOUTH, USE MINUS SIGN ('-') WITH MINUTES.
100 REM (EXAMPLES: -31 DEGR, 10.1 MINS OR 0 DEGR, -10.1 MINS).
110 PI=3.14159:RA=57.29583:DEF FNA(X)=INT(X*100+.5)/100:PT=0:NR=5:C1=0
120 M(1)=50:M(2)=100:M(3)=150:M(4)=250:F(1)=1:F(2)=2:F(3)=3:F(4)=4:F(5)=5
130 U(1)=82:U(2)=82:U(3)=57:U(4)=57:U(5)=88:U(6)=88
140 L(1)=65:L(2)=65:L(3)=48:L(4)=48:L(5)=65:L(6)=65
150 SX(1)=.06336:SX(2)=.12672:SX(3)=.25344:SX(4)=1.01376:SX(5)=2.64
160 SY(1)=13.71494:SY(2)=6.857469:SY(3)=3.428734:SY(4)=.857184:SY(5)=.329159
170 S$(1)="1:1,000,000 SCALE":S$(2)="1:500,000 SCALE":ML$=" MI"
180 S$(3)="1:250,000 SCALE":S$(4)="1:62,500 SCALE":S$(5)="1:24,000 SCALE"
190 PRINT:PRINT:PRINT:REM PUT YOUR CLEAR-SCREEN COMMAND HERE
200 PRINT:PRINT:PRINT " QTH LOCATOR PROGRAM STARTUP MENU"
210 PRINT:PRINT "1 - CONVERT LOCATORS TO COORDINATES"
220 PRINT "2 - CONVERT COORDINATES TO LOCATORS"
230 PRINT "3 - OBTAIN LOCATOR OF A POINT ON MAP"
240 PRINT "4 - PINPOINT A KNOWN LOCATOR ON MAP"
250 PRINT "5 - COMPUTE DX AND CONTEST SCORES"
260 PRINT "6 - CHANGE CONTEST SCORING SYSTEM"
270 PRINT "7 - EXIT"
280 PRINT:INPUT "ENTER 1,2,3,4,5,6 OR 7";CN
290 ON CN GOTO 330,480,1710,2060,680,1160,1590
300 PRINT "INVALID CHOICE.":GOTO 200
310 REM LOCATOR-TO-COORDINATE CONVERSION ROUTINE; 4 AND 6-DIGIT LOCATORS OK.
320 REM IF 4 DIGITS, APPROXIMATE CENTER OF AREA IS ASSUMED.
330 PRINT:PRINT "ENTER LOCATOR TO CONVERT:":GOSUB 340:GOTO 200
340 INPUT G1$
350 IF LEN(G1$)=4 THEN G1$=G1$+"MM"
360 IF LEN(G1$)<>6 THEN 1370
370 FOR K=1 TO 6:A(K)=ASC(MID$(G1$,K,1))
380 IF A(K)>U(K) OR A(K)<L(K) THEN 1370
390 NEXT K
400 LO=180-(A(1)-65)*20-(A(3)-48)*2-(A(5)-64.5)/12
410 LA=-90+(A(2)-65)*10+A(4)-48+(A(6)-64.5)/24
420 XO$="W LONG":LX=ABS(LO):IF LO<0 THEN XO$="E LONG"
430 XA$="N LAT":LY=ABS(LA):IF LA<0 THEN XA$="S LAT"
440 OM=(LX-INT(LX))*60:AM=(LY-INT(LY))*60
450 PRINT G1$;" = ";INT(LX);"DEG ";FNA(OM);"MIN ";XO$
460 PRINT TAB(10)INT(LY);"DEG ";FNA(AM);"MIN ";XA$:RETURN
470 REM COORDINATE-TO-LOCATOR CONVERSION ROUTINE
480 GOSUB 490:GOSUB 610:GOTO 200
490 PRINT:PRINT "USE (-) FOR EAST LONG, SOUTH LAT"
500 PRINT "ENTER THE LONGITUDE (DEGREES,MINS)":INPUT LO,OM
510 L2=ABS(OM):IF LO<0 THEN OM=-L2
520 L1=ABS(LO):LO=LO+OM/60:XO$="W LONG":IF LO<0 THEN XO$="E LONG"
530 IF L1>179 THEN 1340
540 IF L2>59.99 THEN 1340
550 PRINT "ENTER THE LATITUDE (DEGREES,MINS)":INPUT LA,AM
560 L4=ABS(AM):IF LA<0 THEN AM=-L4
570 L3=ABS(LA):LA=LA+AM/60:XA$="N LAT":IF LA<0 THEN XA$="S LAT"
580 IF L3>89 THEN 1340
590 IF L4>59.99 THEN 1340
600 QA=LA:QO=LO:RETURN
610 QP=(180-QO)/20:C=INT(QP):B$=CHR$(C+65):R=(QP-C)*10:C=INT(R):D$=CHR$(C+48)
620 M=(R-C)*24:C=INT(M):F$=CHR$(C+65):QB=(QA+90)/10:C=INT(QB):C$=CHR$(C+65)
630 R=(QB-C)*10:C=INT(R):E$=CHR$(C+48):M=(R-C)*24:C=INT(M):G$=CHR$(C+65)
640 A$=B$+C$+D$+E$+F$+G$
650 PRINT:PRINT "AT ";INT(L1);"/";FNA(L2);XO$;" - ";INT(L3);"/";FNA(L4);XA$
660 PRINT "THE GRIDLOCATOR IS ";A$:RETURN
670 REM CONTEST SCORING ROUTINE--COMPUTES DX, BEAM HEADINGS AND POINT TOTALS.
680 PRINT:PRINT "ENTER YOUR OWN QTH LOCATOR:":GOSUB 340
690 HO=LO/RA:HA=LA/RA:H$=G1$:XX=0
700 PRINT:INPUT "LOCATOR OR COMMAND ('?' FOR MENU)";G1$
710 IF G1$="QRT" THEN PRINT:GOTO 1100
720 IF G1$="X" THEN 1380
730 IF G1$="?" THEN 1400
740 IF G1$="+" THEN 1480
750 IF G1$="-" THEN 1540
760 IF G1$="C" THEN GOSUB 490:GOSUB 610:PRINT:GOTO 700
770 IF G1$="M" THEN GOSUB 1630:PRINT:GOTO 700
780 IF LEN(G1$)>3 THEN GOSUB 350:GOSUB 800:GOTO 1090
790 PRINT "INVALID ENTRY. PLEASE TRY AGAIN.":GOTO 700
800 LO=LO/RA:LA=LA/RA:ZL=LA
810 L=HO-LO:IF L<>0 THEN 840
820 IF HA>ZL THEN AZ=180:GOTO 940
830 IF HA<=ZL THEN AZ=0:GOTO 940
840 IF L>PI THEN L=L-2*PI
850 IF L<-PI THEN L=L+2*PI
860 IF SIN(LA)=0 THEN AA=PI/2:GOTO 880
870 AA=COS(L)*(COS(LA)/SIN(LA)):AA=ATN(AA)
880 IF SIN(AA)=0 THEN AZ=0:GOTO 900
890 AZ=((COS(L)/SIN(L))*COS(HA+AA))/SIN(AA):IF AZ<>0 THEN AZ=ATN(1/AZ)
900 AZ=AZ*RA:L=L*RA
910 IF L>0 AND AZ<0 THEN AZ=AZ+180
920 IF L<0 AND AZ>0 THEN AZ=AZ+180
930 IF L<0 AND AZ<0 THEN AZ=AZ+360
940 AZ=INT(AZ+.5):DX=(SIN(HA)*SIN(LA))+(COS(HA)*COS(LA)*COS(HO-LO))
950 IF DX>1 THEN DX=1
960 IF DX<=-1 THEN DX=180:GOTO 1030
970 DX=SQR(1-(DX*DX))/DX
980 IF HO<>LO THEN 1010
990 IF HA=>ZL THEN DX=HA-LA:GOTO 1020
1000 IF HA<ZL THEN DX=LA-HA:GOTO 1020
1010 DX=ATN(DX)
1020 DX=DX*RA:IF DX<0 AND DX>-90 THEN DX=DX+180
1030 DX=DX*69.0468:KM=DX/.6215:DX=FNA(DX):KM=FNA(KM):PX=F(1)
1040 PRINT "DX FROM CENTER OF ";H$;" TO ";G1$;":"
1050 PRINT TAB(6)DX;" MI";" AND ";KM;" KM":IF ML$=" MI" THEN KM=DX
1060 PRINT TAB(6)AZ;" DEGREES AZIMUTH"
1070 FOR J=1 TO NR-1:IF KM=>M(J) THEN PX=F(J+1)
1080 NEXT J:RETURN
1090 PRINT TAB(6)PX;" PT(S) FOR THIS QSO":PT=PT+PX:D9=D9+KM:QS=QS+1:XX=1
1100 PRINT:PRINT TAB(6)"----------------------"
1110 PRINT TAB(6)PT;" TOTAL PTS"
1120 PRINT TAB(6)D9;" ";ML$;" TOTAL DX"
1130 PRINT TAB(6)QS;" QSOS ENTERED":IF G1$="QRT" THEN 1590
1140 GOTO 700
1150 REM ROUTINE TO MODIFY SCORING SYSTEM.
1160 PRINT:PRINT "UNLESS YOU CHANGE THE VALUES HERE,"
1170 PRINT "THIS SCORING SYSTEM WILL APPLY:":PRINT
1180 PRINT F(1);" PT(S) PER QSO IF DX < ";M(1);ML$:IF NR<=2 THEN 1220
1190 FOR J=2 TO NR-1
1200 PRINT F(J);" PTS IF DX = ";M(J-1);" TO ";M(J);ML$
1210 NEXT J
1220 PRINT F(NR);" PTS IF DX => ";M(NR-1);ML$:PRINT
1230 INPUT "ARE THESE VALUES CORRECT (Y/N)";OK$
1240 IF OK$="Y" THEN 200
1250 PRINT:INPUT "USE MILES (MI) OR KILOMETERS (KM)";ML$:ML$=" "+ML$
1260 PRINT:INPUT "ENTER THE LOWEST PT VALUE";F(1):NR=2
1270 PRINT "ENTER MAXIMUM DX FOR ";F(1);" PT(S)";:INPUT M(1)
1280 PRINT:INPUT "ENTER THE NEXT POINT VALUE";F(NR)
1290 PRINT "ENTER MAXIMUM DX FOR "F(NR);" PTS"
1300 INPUT "(IF NO HIGHER LIMIT EXISTS, ENTER 0)";M(NR)
1310 IF M(NR)=0 THEN 1150
1320 NR=NR+1:GOTO 1280
1330 REM OPERATOR MESSAGES AND EDITING FUNCTIONS
1340 PRINT "ENTRY INCORRECT. MAXIMUM COORDINATES:"
1350 PRINT "89 DEG LATITUDE, 179 DEG LONGITUDE,"
1360 PRINT "AND 59.99 MINUTES":GOTO 490
1370 PRINT "INVALID ENTRY FORMAT. PLEASE TRY AGAIN.":GOTO 340
1380 IF XX=0 THEN PRINT "CAN'T DELETE":GOTO 700
1390 XX=0:QS=QS-1:PT=PT-PX:D9=D9-KM:PRINT "--LAST ENTRY DELETED--":GOTO 1100
1400 PRINT:PRINT:PRINT TAB(12)"DATA ENTRY MENU":PRINT
1410 PRINT "YOU MAY ENTER A STATION'S LOCATOR, OR--"
1420 PRINT:PRINT "'X' TO DELETE THE LAST ENTRY"
1430 PRINT "'+' TO ADD PRIOR QSOS TO TOTALS"
1440 PRINT "'-' TO DELETE ANY PREVIOUS QSO"
1450 PRINT "'C' TO CONVERT COORDINATES TO LOCATOR"
1460 PRINT "'M' TO PERFORM MAP OPERATIONS"
1470 PRINT "'QRT' TO END SESSION":PRINT:GOTO 700
1480 PRINT:PRINT:PRINT "THIS OPTION ALLOWS YOU TO ADD QSOS,"
1490 PRINT "DX, AND CONTEST POINTS FROM"
1500 PRINT "A PREVIOUS SESSION TO YOUR TOTALS.":PRINT
1510 PRINT "HOW MANY QSOS TO ADD?":INPUT Q1:QS=QS+Q1
1520 PRINT "HOW MANY TOTAL MILES (OR KM) TO ADD?":INPUT D1:D9=D9+D1
1530 PRINT "HOW MANY POINTS TO ADD?":INPUT P1:PT=PT+P1:GOTO 1100
1540 PRINT:PRINT:PRINT "THIS OPTION ALLOWS YOU TO DELETE"
1550 PRINT "ANY PREVIOUS QSO FROM THE TOTALS"
1560 PRINT "BY ENTERING ITS LOCATOR.":PRINT
1570 INPUT "LOCATOR TO DELETE";G1$:GOSUB 350:GOSUB 800
1580 QS=QS-1:PT=PT-PX:D9=D9-KM:XX=0:GOTO 1100
1590 PRINT:PRINT "NOTE: YOU HAVE EXITED THE PROGRAM."
1600 PRINT "BE SURE TO WRITE DOWN YOUR DATA"
1610 PRINT "BEFORE TURNING OFF YOUR COMPUTER!":END
1620 REM MAP CONVERSION ROUTINES
1630 PRINT:PRINT "MAP OPERATIONS. CHOOSE EITHER--"
1640 PRINT "1 - OBTAIN LOCATOR OF A POINT ON MAP"
1650 PRINT "2 - PINPOINT A KNOWN LOCATOR ON MAP"
1660 PRINT "ENTER 1 OR 2";:INPUT M9
1670 IF M9=1 THEN GOSUB 1720:GOTO 700
1680 IF M9=2 THEN GOSUB 2070:GOTO 700
1690 PRINT "INVALID CHOICE--TRY AGAIN":GOTO 1630
1700 REM ROUTINES TO OBTAIN QTH LOCATOR OF A POINT ON A MAP
1710 GOSUB 1720:GOTO 200
1720 GOSUB 2200:PRINT:PRINT "MEASURE THE VERTICAL AND HORIZONTAL"
1730 PRINT "DISTANCE FROM THE REFERENCE POINT"
1740 PRINT "TO THE POINT FOR WHICH YOU NEED"
1750 PRINT "A QTH LOCATOR.":PRINT
1760 PRINT "NOTE: USE MINUS ('-') TO INDICATE A"
1770 PRINT "DISTANCE SOUTH OR EAST OF REFERENCE PT.":PRINT
1780 INPUT "# INCHES VERTICALLY FROM REF PT.";V
1790 INPUT "# INCHES HORIZONTALLY FROM REF. PT.";H
1800 IF ABS(M3+(V*S2/50))<90 THEN 1820
1810 PRINT "ERROR: ENTRY >90 DEGR LAT":GOTO 1780
1820 C2=4:IF H=>0 AND V<0 THEN C2=1
1830 IF V=>0 AND H=>0 THEN C2=2
1840 IF V=>0 AND H<0 THEN C2=3
1850 V3=ABS(V)*S2:H3=ABS(H)*S2
1860 IF V3=0 THEN A3=90:GOTO 1880
1870 A3=(ATN(H3/V3))*RA
1880 R3=(H3^2+V3^2)^.5
1890 IF C2=1 THEN T3=A3+180
1900 IF C2=2 THEN T3=360-A3
1910 IF C2=3 THEN T3=A3
1920 IF C2=4 THEN T3=180-A3
1930 NA=(R3*(COS(T3/RA))/60)+M3:XA$="N LAT":IF NA<0 THEN XA$="S LAT"
1940 IF T3=90 THEN 1990
1950 IF T3=270 THEN 1990
1960 X=LOG(TAN((45+(M3/2))/RA)):X1=LOG(TAN((45+(NA/2))/RA))
1970 NO=M4+RA*(TAN(T3/RA))*(X-X1)
1980 GOTO 2000
1990 NO=M4-(R3*SIN(T3/RA))/(60*COS(M3/RA))
2000 IF NO=>180 THEN NO=NO-360
2010 IF NO=<-180 THEN NO=360+NO
2020 XO$="W LONG":IF NO<0 THEN XO$="E LONG"
2030 QA=NA:NA=ABS(NA):L3=INT(NA):L4=(NA-INT(NA))*60
2040 QO=NO:NO=ABS(NO):L1=INT(NO):L2=(NO-INT(NO))*60:GOTO 610
2050 REM ROUTINES TO PINPOINT A KNOWN QTH LOCATOR ON A MAP
2060 GOSUB 2070:GOTO 200
2070 GOSUB 2200:PRINT:PRINT "ENTER THE GRIDLOCATOR THAT YOU"
2080 PRINT "WISH TO PINPOINT ON YOUR MAP":GOSUB 340
2090 NA=LA:NO=LO:A4=ABS((M3+NA)/2):D4=ABS(M3-NA):D5=ABS(M4-NO)
2100 D6=69.0541-.351726*COS((2*A4)/RA)
2110 D7=69.23001*COS(A4/RA)-.05875*COS((3*A4)/RA)
2120 V4=D6*D4*S3:G4=D7*D5*S3
2130 X7$=" NORTH":IF LA<M3 THEN X7$=" SOUTH"
2140 X8$=" WEST":IF LO<M4 THEN X8$=" EAST"
2150 PRINT:PRINT "THE CENTER OF ";G1$;" IS"
2160 PRINT FNA(V4);" INCHES ";X7$
2170 PRINT "FROM THE REFERENCE POINT AND"
2180 PRINT FNA(G4);" INCHES ";X8$
2190 PRINT "FROM THE REFERENCE POINT":RETURN
2200 IF C1=0 THEN 2270
2210 PRINT:PRINT "CURRENT MAP PARAMETERS:"
2220 PRINT:PRINT "REFERENCE POINT IS"
2230 PRINT INT(L5);"/";FNA(L6);X1$;" - ";INT(L7);"/";FNA(L8);X2$
2240 IF S1=6 THEN PRINT "MAP SCALE: ";MI;" MILES/INCH":GOTO 2260
2250 PRINT "MAP USES ";S$(S1)
2260 INPUT "WANT TO CHANGE MAP PARAMETERS (Y/N)";CM$:IF CM$<>"Y" THEN RETURN
2270 PRINT:PRINT "PLEASE DESCRIBE YOUR MAP AND SELECT"
2280 PRINT "A REFERENCE POINT FOR MEASUREMENTS."
2290 PRINT "------------------------------------"
2300 PRINT "| : |"
2310 PRINT "| X----------: |"
2320 PRINT "| : : |"
2330 PRINT "| : : |"
2340 PRINT "|................R.................|"
2350 PRINT "| : |"
2360 PRINT "| : |"
2370 PRINT "| : |"
2380 PRINT "| : |"
2390 PRINT "------------------------------------"
2400 PRINT "(R IS YOUR REFERENCE POINT ON THE MAP,"
2410 PRINT "AND X IS AN UNKNOWN POINT OR LOCATOR).":C1=1:PRINT
2420 PRINT "FOR YOUR REFERENCE POINT ON THE MAP:"
2430 GOSUB 490:M3=LA:M4=LO:L5=L1:L6=L2:L7=L3:L8=L4:X1$=XO$:X2$=XA$
2440 PRINT:PRINT "NOW SPECIFY THE MAP'S SCALE:"
2450 PRINT:PRINT TAB(7)"1. ";S$(1):PRINT TAB(7)"2. ";S$(2)
2460 PRINT TAB(7)"3. ";S$(3):PRINT TAB(7)"4. ";S$(4)
2470 PRINT TAB(7)"5. ";S$(5):PRINT TAB(7)"6. ANY # MILES/INCH"
2480 PRINT:INPUT "ENTER 1,2,3,4,5 OR 6";S1:IF S1=6 THEN 2510
2490 IF S1>6 THEN PRINT "INVALID SCALE--TRY AGAIN.":GOTO 2440
2500 S2=SY(S1):S3=SX(S1):GOTO 2210
2510 PRINT:INPUT "ENTER MAP SCALE IN MILES/INCH";MI
2520 S2=MI/1.15078:S3=1/MI:GOTO 2210